home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / subcalc.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-06  |  3.5 KB  |  103 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         subcalc.lsp
  5. ; RCS:          $Header: subcalc.lsp,v 1.2 91/10/05 18:56:08 mayer Exp $
  6. ; Description:  Demo of spawning an interactive subprocess and interacting
  7. ;        with the subrpocess through XT_ADD_INPUT. Subprocess can be
  8. ;        off doing a long calculation while WINTERP GUI remains active.
  9. ;            Subprocesses and XT_ADD_INPUT only available in WINTERP 1.14...
  10. ; Author:       Niels Mayer, HPLabs
  11. ; Created:      Sat Oct  5 18:51:56 1991
  12. ; Modified:     Sat Oct  5 18:55:57 1991 (Niels Mayer) mayer@hplnpm
  13. ; Language:     Lisp
  14. ; Package:      N/A
  15. ; Status:       X11r5 contrib tape release
  16. ;
  17. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  18. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  19. ;
  20. ; Permission to use, copy, modify, distribute, and sell this software and its
  21. ; documentation for any purpose is hereby granted without fee, provided that
  22. ; the above copyright notice appear in all copies and that both that
  23. ; copyright notice and this permission notice appear in supporting
  24. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  25. ; used in advertising or publicity pertaining to distribution of the software
  26. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  27. ; makes no representations about the suitability of this software for any
  28. ; purpose.  It is provided "as is" without express or implied warranty.
  29. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30.  
  31. (let (                    ;declare local variables
  32.       subproc_pty input-cb command_editor_w quit_button_w list_w top_w rc_w
  33.       )
  34.  
  35.   ;;; Widgets
  36.  
  37.   (setq top_w
  38.     (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "Calc" "calc"
  39.           ))
  40.   (setq rc_w
  41.     (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed "rc" top_w
  42.           :XMN_ORIENTATION        :vertical
  43.           :XMN_PACKING        :pack_tight
  44.           :XMN_ENTRY_ALIGNMENT    :alignment_center
  45.           ))
  46.   (setq quit_button_w
  47.     (send XM_PUSH_BUTTON_WIDGET_CLASS :new :managed rc_w
  48.           :XMN_LABEL_STRING        "Quit"
  49.           ))
  50.   (setq command_editor_w 
  51.     (send XM_TEXT_FIELD_WIDGET_CLASS :new :managed rc_w
  52.           ))
  53.   (setq list_w
  54.     (send XM_LIST_WIDGET_CLASS :new :managed :scrolled rc_w
  55.           :XMN_VISIBLE_ITEM_COUNT    20
  56.           ))
  57.  
  58.   (send top_w :realize)
  59.  
  60.   ;;; Callbacks
  61.  
  62.   (send quit_button_w :set_callback    ;XtAppAddCallback()
  63.     :XMN_ACTIVATE_CALLBACK        ;invoke when button pushed...
  64.     '()                ;no local vars.
  65.     '(                ;callback code
  66.       (xt_remove_input input-cb)    ;must remove this before closing
  67.       (close subproc_pty)        ;close the file --> quits subprocess
  68.       (exp_wait)            ;wait on the subprocess
  69.       ))
  70.  
  71.   (send command_editor_w :set_callback    ;XtAppAddCallback()
  72.     :XMN_ACTIVATE_CALLBACK        ;invoke when <return> ... hit.
  73.     '(callback_widget)        ;bound to the current value of command_editor_w
  74.     '(                ;code to execute
  75.       (format subproc_pty "~A\n"    ;send text in editor to the subprocess
  76.           (send callback_widget :get_string))
  77.       )
  78.     )
  79.  
  80.   ;;; Subprocess
  81.  
  82.   (setq subproc_pty (exp_spawn "bc" "bc")) ;create subprocess, the bc(1) calculator
  83.  
  84.   (let ((line NIL))            ;for every line output from bc(1), append result-
  85.     (setq input-cb            ;-to list widget...
  86.       (xt_add_input subproc_pty
  87.             :read
  88.             '(
  89.               (let ((c (read-char FDINPUTCB_FILE)))
  90.                 (cond
  91.                  ((char= c #\newline) 
  92.                   (send list_w :add_item (format nil "~A" (reverse (cdr line))) 0)
  93.                   (send list_w :set_bottom_pos 0)
  94.                   (setq line nil)
  95.                   )
  96.                  (t
  97.                   (setq line (cons c line))
  98.                   ))
  99.                 ))))
  100.     )
  101.  
  102.   )
  103.